home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / tasking / dateutil.mod < prev    next >
Text File  |  1986-03-10  |  2KB  |  52 lines
  1. IMPLEMENTATION MODULE DateUtilities;
  2.  
  3.   FROM TimeDate IMPORT Time;
  4.  
  5.   VAR
  6.     mnthtbl: ARRAY [1 .. 12] OF CARDINAL;
  7.  
  8.   PROCEDURE DayOfWeek(date: Time): CARDINAL;
  9.     (* returns 0 = Sunday, ... 6 = Saturday*)
  10.     BEGIN
  11.       RETURN DayNum(date) MOD 7;
  12.     END DayOfWeek;
  13.  
  14.   PROCEDURE DateDifference(First, Last: Time): CARDINAL;
  15.     (* returns the numbers of days from first to last *)
  16.     BEGIN
  17.       RETURN DayNum(Last) - DayNum(First);
  18.     END DateDifference;
  19.  
  20.   PROCEDURE SetDate(Year, Month, Day: CARDINAL; VAR Date: Time);
  21.     (* set the date word of the timestamp *)
  22.     (* 1900 < Year < 2100, 1 <= Month <= 12, 1 <= Day <= 31 *)
  23.     BEGIN
  24.       Date.day := (Year - 1900) * 512 + Month * 32 + Day;
  25.     END SetDate;
  26.  
  27.   PROCEDURE DayNum(date: Time): CARDINAL;
  28.     VAR
  29.       Day, Month, Year: CARDINAL;
  30.     BEGIN
  31.       Day := date.day MOD 32;
  32.       Month := date.day DIV 32 MOD 16;
  33.       Year := date.day DIV 512;
  34.       IF (Month > 2) & (Year MOD 4 = 0) THEN INC(Day) END;
  35.       RETURN Day + mnthtbl[Month] + (Year * 365) + Year DIV 4;
  36.     END DayNum;
  37.  
  38.   BEGIN
  39.     mnthtbl[1] := 0;   (* jan 31 *)
  40.     mnthtbl[2] := 31;  (* feb 28 or 29 *)
  41.     mnthtbl[3] := 59;  (* mar 31 *)
  42.     mnthtbl[4] := 90;  (* apr 30 *)
  43.     mnthtbl[5] := 120; (* may 31 *)
  44.     mnthtbl[6] := 151; (* jun 30 *)
  45.     mnthtbl[7] := 181; (* jul 31 *)
  46.     mnthtbl[8] := 212; (* aug 31 *)
  47.     mnthtbl[9] := 243; (* sep 30 *)
  48.     mnthtbl[10] := 273;(* oct 31 *)
  49.     mnthtbl[11] := 304;(* nov 30 *)
  50.     mnthtbl[12] := 334;(* dec 31 *)
  51.   END DateUtilities.
  52.